home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok34.lha / StartupMenu / StartupMenu.MOD < prev    next >
Text File  |  1993-08-15  |  14KB  |  390 lines
  1. (*************************************************************************
  2.  
  3.   :Program.       StartupMenu
  4.   :Author.        Martin Horneffer
  5.   :Address.       Semester: Süsterfeldstr.30, 5100 Aachen
  6.   :Address.       sonst:    Stenzelbergstr.23, 5330 Königswinter 41
  7.   :Address.       Zerberus-Net: KOX@MIDI.ZER
  8.   :Address.       Maus-Net: Martin Horneffer @ BN
  9.   :Address.              &  Martin Horneffer @ BN2
  10.   :History.       V1.0 ??-Apr-1989 Martin Horneffer
  11.   :Copyright.     PD
  12.   :Language.      MODULA-II
  13.   :Translator.    M2Amiga 3.11d
  14.   :Imports.       IntuiStruct1.3 [bne]
  15.  
  16.   :Contents.      Intuitiongesteuertes Zusammenstellen einer Batch-Datei
  17.   :Contents.      aus vorgegebenen Teilen mit Hilfe von Boolean-Gadgets,
  18.   :Contents.      die sich gegenseitig ausschließen können
  19.  
  20.   :Remark.        Nützlich für alle, die für gewöhnlich auch verschiedene
  21.   :Remark.        Anwendungen von einer einzigen Diskette oder FESTPLATTE
  22.   :Remark.        booten und beim "startup" verschiedene Einstellungen
  23.   :Remark.        vornehmen möchten.
  24.  
  25. *************************************************************************)
  26.  
  27. (*            Achtung !!!
  28.       Leute, bei denen englisch/deutsch gemischte Bezeichner
  29.    Übelkeit hervorrufen, sollten besser nicht weiterlesen.
  30.    Der Quell-(Quäl-?)Text wäre gesundheitsgefährdend.
  31.  
  32.       Wer sich hingegen von "treffenden" Bezeichnern wie 'TitelFontName',
  33.    oder 'AnzahlGadgets' nicht abschrecken lassen, kann immerhin sehen,
  34.    wie man auch ohne 'RefreshGList()' mutual-exclude-Gadgets implementiert,
  35.    oder wie man Modula-2 beibringt, dieselbe Variable mal als LONGCARD,
  36.    mal als POINTER TO CHAR, ADDRESS, oder POINTER TO ARRAY OF CHAR zu
  37.    betrachten, und kann durch einfaches Ändern von Konstanten das
  38.    ganze Window-Design neu gestalten.
  39. *)
  40.  
  41. MODULE StartupMenu ;
  42.  
  43. FROM DiskFont   IMPORT  OpenDiskFont;
  44. FROM SYSTEM     IMPORT  ADDRESS, ADR, LONGSET, CAST;
  45. FROM InOut      IMPORT  WriteString, WriteLn, WriteCard, Write, WriteHex;
  46. FROM Arts       IMPORT  Assert, TermProcedure, Terminate;
  47. FROM Arguments  IMPORT  NumArgs, GetArg;
  48. FROM FileSystem IMPORT  File, Lookup, Close, ReadChar, WriteChar,
  49.                         Response, Length, ReadBytes, WriteBytes;
  50. IMPORT Strings ;
  51. FROM IntuiStruct IMPORT StructWindow, StructText, StructGadget,
  52.                         AllocProc, DeallocProc, StructBorder, Rectangle,
  53.                         BorderEnd, FreeBorder;
  54. FROM Heap       IMPORT  AllocMem, Deallocate;
  55. FROM Intuition  IMPORT  NewWindow, WindowPtr, IDCMPFlags, IDCMPFlagSet,
  56.                         WindowFlags, WindowFlagSet, OpenWindow, CloseWindow,
  57.                         Gadget, GadgetPtr, GadgetFlags, GadgetFlagSet,
  58.                         ActivationFlags, ActivationFlagSet, IntuiText,
  59.                         boolGadget, ScreenFlags, ScreenFlagSet, Border,
  60.                         AddGadget, RefreshGadgets, IntuiMessagePtr,
  61.                         PrintIText ;
  62. FROM Graphics   IMPORT  DrawModeSet, DrawModes, jam1, TextLength, Text,
  63.                         RastPortPtr, TextAttr, FontStyleSet, FontStyles,
  64.                         FontFlagSet, FontFlags, CloseFont, AddFont, Draw,
  65.                         TextFontPtr, SetFont, Move, SetAPen, SetSoftStyle,
  66.                         RectFill;
  67. FROM Exec       IMPORT  WaitPort, GetMsg, ReplyMsg ;
  68.  
  69. CONST   MaxKnopf        = 22 ;
  70.         eolc            = 12C ;
  71.         Titel           = "Startup - Menu" ;
  72.         TitelFontName   = "courier.font" ;
  73.         TitelFontSize   =  24 ;
  74.         TitelTop        =   8 ;
  75.         WinX            = 600 ;
  76.         WinY            = 220 ;
  77.         WinTop          =  20 ;
  78.         WinLeft         =  20 ;
  79.         GadTop          =  40 ;
  80.         GadLeft1        =  35 ;
  81.         GadLeft2        = 360 ;
  82.         GadX            = 203 ;
  83.         GadY            =  10 ;
  84.         GadDY           =  16 ;
  85.         EndGadText      = "Fertig" ;
  86.         EndGadLeft      = 270 ;
  87.         EndGadTop       =  GadTop ;
  88.         EndGadX         =  60 ;
  89.         doubleKlick     = 500 ;
  90.  
  91. TYPE    KnopfNum        = [0..MaxKnopf-1] ;
  92.         StrPtr          = RECORD CASE :CARDINAL OF
  93.                               0 :  p:POINTER TO ARRAY [0..32000] OF CHAR |
  94.                               1 :  a:ADDRESS |
  95.                               2 :  w:LONGINT |
  96.                               3 :  c:POINTER TO CHAR |
  97.                           END ; END ;
  98.  
  99. VAR     mNWindow        : NewWindow ;
  100.         mWindow         : WindowPtr ;
  101.         rp              : RastPortPtr ;
  102.         mBorder, EndGadBorder
  103.                         : Border ;
  104.         message         : IntuiMessagePtr ;
  105.         t1, t2          : LONGCARD ;
  106.         klasse          : IDCMPFlagSet ;
  107.         taste           : CARDINAL ;
  108.         TTextAttr       : TextAttr ;
  109.         TText1, TText2  : IntuiText ;
  110.         TitelLeft, TitelLen
  111.                         : INTEGER ;
  112.         TitelFont       : TextFontPtr ;
  113.         firstGadget, iadr1, iadr2
  114.                         : GadgetPtr ;
  115.         EndGad          : Gadget ;
  116.         EndGadY         : INTEGER ;
  117.         EndGadITxt      : IntuiText ;
  118.         gadget          : ARRAY KnopfNum OF Gadget ;
  119.         gtext           : ARRAY KnopfNum OF IntuiText ;
  120.         gname           : ARRAY KnopfNum OF StrPtr ;
  121.         excludes        : ARRAY KnopfNum OF StrPtr ;
  122.         commands        : ARRAY KnopfNum OF StrPtr ;
  123.         AnzahlGadgets   : CARDINAL ;
  124.         text            : StrPtr ;
  125.         textLen         : LONGINT ;
  126.  
  127.         dummyi          : INTEGER ;
  128.         dummyl          : LONGINT ;
  129.         dummys          : FontStyleSet ;
  130.         f, cf           : File ;
  131.  
  132. PROCEDURE Ende ;
  133.   BEGIN
  134.     IF mWindow # NIL THEN
  135.       CloseWindow(mWindow); END ;
  136.     IF TitelFont#NIL THEN CloseFont(TitelFont)  END ;
  137.     Close(f) ;
  138.     Close(cf) ;
  139.   END Ende ;
  140.  
  141. PROCEDURE Rect( x1,y1,x2,y2, col : INTEGER ; fill : BOOLEAN );
  142.   BEGIN
  143.     SetAPen( rp, col);
  144.     IF fill THEN
  145.       RectFill( rp, x1,y1,x2,y2);
  146.     ELSE
  147.       Move( rp, x1,y1);
  148.       Draw( rp, x2,y1); Draw( rp, x2,y2); Draw( rp, x1, y2); Draw( rp, x1,y1);
  149.     END ;
  150.   END Rect ;
  151.  
  152. PROCEDURE ExcludeGadget(Gadgets:GadgetPtr;Window:WindowPtr;
  153.                 Requester:ADDRESS;Mask:LONGSET);
  154. VAR     TempPtr:GadgetPtr;
  155.         Bit:INTEGER;
  156. BEGIN
  157.   Bit:=0;
  158.   WHILE (Gadgets#NIL)AND(Bit<32) DO
  159.     IF (Bit IN Mask)AND(selected IN Gadgets^.flags) THEN
  160.       WITH Gadgets^ DO
  161.         Rect( leftEdge, topEdge, leftEdge+width, topEdge+height, 0, TRUE);
  162.         flags:=flags-GadgetFlagSet{selected};
  163.         TempPtr:=nextGadget;
  164.         nextGadget:=NIL;
  165.         RefreshGadgets(Gadgets,Window,Requester);
  166.         nextGadget:=TempPtr;
  167.       END;
  168.     END;
  169.     Gadgets:=Gadgets^.nextGadget;
  170.     INC(Bit);
  171.   END;
  172. END ExcludeGadget;
  173.  
  174. PROCEDURE suche(VAR p:StrPtr; c:CHAR) : BOOLEAN ;
  175.   BEGIN
  176.     WHILE ( p.c^ # c ) AND ( p.w-text.w < textLen ) DO  INC(p.w)  END ;
  177.     RETURN ( p.w-text.w < textLen ) ;
  178.   END suche ;
  179.  
  180. PROCEDURE MakeGadget( n:CARDINAL) ;
  181.   VAR   i, l, length    : INTEGER ;
  182.         c               : CHAR ;
  183.         sel             : GadgetFlagSet ;
  184.         wasEol          : BOOLEAN ;
  185.         pos             : StrPtr ;
  186.   BEGIN
  187.     pos.w := gname[n].w - 1 ;
  188.     IF pos.c^ = '+' THEN sel := GadgetFlagSet{selected} ;
  189.     ELSE sel := GadgetFlagSet{}; END ;
  190.  
  191.     length := TextLength( rp, gname[n].a, Strings.Length(gname[n].p^) ) ;
  192.  
  193.       (* Excludes *)
  194.     pos := excludes[n] ;
  195.     WHILE pos.w < commands[n].w DO
  196.       Assert( suche( pos, eolc), ADR("Datei unvollständig (Excludes)") ) ;
  197.       IF pos.w < commands[n].w THEN
  198.         pos.c^ := 0C ;
  199.         l := pos.w - excludes[n].w ;
  200.         FOR i := 0 TO AnzahlGadgets-1 DO
  201.           IF Strings.Compare( excludes[n].p^, 0, l, gname[i].p^, FALSE ) = 0
  202.             THEN
  203.               INCL( gadget[n].mutualExclude, i) ;
  204.               INCL( gadget[i].mutualExclude, n)
  205.             END ;
  206.         END ; (* FOR *)
  207.         INC( pos.w ) ;
  208.         excludes[n].w := pos.w ;
  209.       END ; (* IF *)
  210.     END ; (* WHILE *)
  211.  
  212.     StructText( gtext[n], 1,0, jam1, (GadX-length) DIV 2,1,
  213.                 ADR(gname[n].p^), NIL);
  214.     StructGadget( gadget[n], GadLeft1,(n DIV 2)*GadDY+GadTop, GadX, GadY,
  215.                   GadgetFlagSet{}+sel,
  216.                   ActivationFlagSet{gadgImmediate,toggleSelect, relVerify},
  217.                   boolGadget, ADR(mBorder), ADR(gtext[n]),
  218.                   gadget[n].mutualExclude, n, NIL);
  219.     IF n MOD 2 = 1 THEN
  220.       gadget[n].leftEdge := GadLeft2; END ;
  221.     dummyi :=  AddGadget( mWindow, ADR(gadget[n]), -1 ) ;
  222.   END MakeGadget ;
  223.  
  224. PROCEDURE TextLesen ;
  225.   VAR   Filename        : ARRAY [1..200] OF CHAR ;
  226.         dummyp          : StrPtr ;
  227.   BEGIN
  228.     Assert( NumArgs()=2, ADR("Bitte zwei Dateinamen abgeben !"));
  229.     GetArg( 1, Filename, dummyi);
  230.     Lookup( f, Filename, 512, FALSE);
  231.     Assert( f.res=done, ADR("Datei läßt sich nicht lesen !"));
  232.  
  233.     Length(f, textLen) ;
  234.     AllocMem( text.a, textLen+2, FALSE) ;
  235.     Assert( text.a#NIL, ADR("Nicht genug RAM !")) ;
  236.  
  237.     ReadBytes( f, text.a, textLen, dummyl) ;
  238.     Assert( textLen=dummyl, ADR("Fehler beim Lesen der Datei !")) ;
  239.  
  240.     dummyp.w := textLen+text.w ;
  241.     dummyp.c^ := 0C ;
  242.   END TextLesen ;
  243.  
  244. PROCEDURE EintraegeSuchen ;
  245.   VAR   pos     : StrPtr ;
  246.   BEGIN
  247.     pos := text ;
  248.     AnzahlGadgets := 0 ;
  249.     WHILE suche( pos, '#' )  DO
  250.       pos.c^ := 0C ;
  251.       gname[AnzahlGadgets].w := pos.w+2 ;
  252.       Assert( suche(pos,eolc), ADR("Falsches Format: Knopfname")) ;
  253.       pos.c^ := 0C ;
  254.       excludes[AnzahlGadgets].w := pos.w+1 ;
  255.       Assert( suche(pos,'%'), ADR("Falsches Format: Excludes")) ;
  256.       pos.c^ := 0C ;
  257.       commands[AnzahlGadgets].w := pos.w+1 ;
  258.       INC( AnzahlGadgets ) ;
  259.     END ;
  260.   END EintraegeSuchen ;
  261.  
  262. PROCEDURE Gadgets ;
  263.   VAR   c               : CHAR ;
  264.         i               : CARDINAL ;
  265.         newGadget       : GadgetPtr ;
  266.   BEGIN
  267.     AllocProc := AllocMem;
  268.     DeallocProc := Deallocate;
  269.     mBorder.xy := NIL ;
  270.  
  271.     StructBorder(mBorder, -1,-1, 2, jam1, 4, NIL);
  272.     Rectangle( GadX+2, GadY+2);
  273.     BorderEnd;
  274.  
  275.     TextLesen ;
  276.     EintraegeSuchen ;
  277.     FOR i:=0 TO AnzahlGadgets-1 DO
  278.       MakeGadget(i) ;
  279.     END ;
  280.  
  281.     firstGadget := ADR(gadget[0]);
  282.  
  283.     EndGadY := ((AnzahlGadgets+1) DIV 2) * GadDY - GadDY + GadY ;
  284.     StructBorder(EndGadBorder, -1, -1, 2, jam1, 4, NIL);
  285.     Rectangle( EndGadX+2, EndGadY+2);
  286.     BorderEnd;
  287.     StructText(EndGadITxt,1,0,jam1, 6,EndGadY DIV 2 -4,ADR(EndGadText),NIL);
  288.     StructGadget( EndGad, EndGadLeft, EndGadTop, EndGadX, EndGadY,
  289.                 GadgetFlagSet{}, ActivationFlagSet{gadgImmediate, relVerify},
  290.                 boolGadget, ADR(EndGadBorder), ADR(EndGadITxt),
  291.                 LONGSET{}, MaxKnopf+1, NIL);
  292.     dummyi := AddGadget( mWindow, ADR(EndGad), -1);
  293.  
  294.     RefreshGadgets( firstGadget, mWindow, NIL);
  295.  
  296.     WITH TTextAttr DO
  297.       name:=ADR(TitelFontName);
  298.       ySize:=TitelFontSize;
  299.       style:=FontStyleSet{italic, bold};
  300.       flags:=FontFlagSet{diskFont};
  301.     END;
  302.     TitelFont := OpenDiskFont(ADR(TTextAttr));
  303.     SetFont( rp,TitelFont);
  304.     TitelLen := TextLength( rp, ADR(Titel), SIZE(Titel)) ;
  305.     TitelLeft := (WinX-TitelLen) DIV 2 ;
  306.     StructText( TText1, 2,0, jam1, 0, 0, ADR(Titel), NIL);
  307.     StructText( TText2, 1,0, jam1, -3, -2, ADR(Titel), NIL);
  308.     TText1.iTextFont := ADR(TTextAttr) ;
  309.     TText2.iTextFont := ADR(TTextAttr) ;
  310.  
  311.     Rect( TitelLeft-11, TitelTop-1, TitelLeft+TitelLen+14,
  312.           TitelTop+TitelFontSize+1, 2, TRUE) ;
  313.     Rect( TitelLeft-9, TitelTop, TitelLeft+TitelLen+12,
  314.           TitelTop+TitelFontSize, 3, TRUE) ;
  315.  
  316.     PrintIText( rp, ADR(TText1), TitelLeft, TitelTop);
  317.     PrintIText( rp, ADR(TText2), TitelLeft, TitelTop);
  318.  
  319.     Rect( 1, 1, WinX-2, WinY-2, 2, FALSE);
  320.     Rect( 2, 1, WinX-3, WinY-2, 2, FALSE);
  321.     Rect( 3, 2, WinX-4, WinY-3, 1, FALSE);
  322.  
  323.   END Gadgets ;
  324.  
  325. PROCEDURE FensterOeffnen ;
  326.   BEGIN
  327.     StructWindow( mNWindow, WinLeft, WinTop, WinX, WinY, 0, 1,
  328.                 IDCMPFlagSet{closeWindow,vanillaKey,gadgetUp,gadgetDown},
  329.                 WindowFlagSet{activate},
  330.                 NIL, NIL, ScreenFlagSet{wbenchScreen} );
  331.     mWindow := OpenWindow( mNWindow);
  332.     Assert( mWindow#NIL, ADR("Kein Fenster !"));
  333.     rp := mWindow^.rPort;
  334.   END FensterOeffnen ;
  335.  
  336. PROCEDURE ScriptAusgeben ;
  337.   VAR   g       : GadgetPtr ;
  338.         n, i    : CARDINAL ;
  339.         Filename: ARRAY [1..80] OF CHAR;
  340.   BEGIN
  341.     GetArg( 2, Filename, dummyi);
  342.     Lookup( cf, Filename, 512, TRUE);
  343.     Assert( cf.res=done, ADR("Datei läßt sich nicht erzeugen !"));
  344.  
  345.     g:=firstGadget;
  346.     WHILE g # NIL DO
  347.       IF selected IN g^.flags THEN
  348.         n := g^.gadgetID ; i := 0 ;
  349.         WHILE commands[n].p^[i] # 0C DO
  350.           WriteChar( cf, commands[n].p^[i]);
  351.           INC(i);
  352.         END ;
  353.       END ;
  354.     g := g^.nextGadget;
  355.     END ;
  356.   END ScriptAusgeben ;
  357.  
  358. BEGIN (* main *)
  359.   TermProcedure( Ende) ;
  360.   FensterOeffnen ;
  361.   Gadgets ;
  362.  
  363.   LOOP
  364.     WaitPort(mWindow^.userPort) ;
  365.     message := GetMsg(mWindow^.userPort) ;
  366.     WITH message^ DO
  367.       t1 := (seconds MOD 1000) * 1000 + (micros DIV 1000) ;
  368.       iadr1 := iAddress ;
  369.       klasse := class ;
  370.       taste := code ;
  371.     END ;
  372.     ReplyMsg(message) ;
  373.     IF (gadgetDown IN klasse) AND (selected IN iadr1^.flags) THEN
  374.       ExcludeGadget( firstGadget, mWindow, NIL, iadr1^.mutualExclude) ;
  375.     END ;
  376.     IF (gadgetDown IN klasse) AND (t1 < t2 + doubleKlick) AND
  377.        (iadr1 = iadr2)  THEN
  378.       INCL(iadr1^.flags, selected) ;
  379.       EXIT ;
  380.     END ;
  381.     IF (gadgetUp IN klasse) AND (iadr1=ADR(EndGad))  OR
  382.        (vanillaKey IN klasse) AND (taste=13) THEN  EXIT
  383.     END ;
  384.     t2 := t1 ;
  385.     iadr2 := iadr1 ;
  386.   END ; (* LOOP *)
  387.  
  388.   ScriptAusgeben;
  389. END StartupMenu .
  390.